home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Dynamic Bu22180742001.psc / Controls / ButtonBar.ctl next >
Encoding:
Text File  |  2001-07-04  |  15.9 KB  |  447 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ButtonBar 
  3.    Alignable       =   -1  'True
  4.    BackColor       =   &H80000000&
  5.    ClientHeight    =   8415
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   9015
  9.    DefaultCancel   =   -1  'True
  10.    ScaleHeight     =   8415
  11.    ScaleWidth      =   9015
  12.    Begin VB.PictureBox picMain 
  13.       BackColor       =   &H80000010&
  14.       Height          =   5535
  15.       Left            =   0
  16.       ScaleHeight     =   5475
  17.       ScaleWidth      =   1995
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   2055
  21.       Begin prjButtonBar.LargeIcon LargeIcon1 
  22.          Height          =   1215
  23.          Index           =   0
  24.          Left            =   0
  25.          TabIndex        =   1
  26.          Top             =   0
  27.          Visible         =   0   'False
  28.          Width           =   1935
  29.          _ExtentX        =   3413
  30.          _ExtentY        =   2143
  31.       End
  32.    End
  33. End
  34. Attribute VB_Name = "ButtonBar"
  35. Attribute VB_GlobalNameSpace = False
  36. Attribute VB_Creatable = True
  37. Attribute VB_PredeclaredId = False
  38. Attribute VB_Exposed = True
  39. Option Explicit
  40. Private cmdGroup                    As CommandButton
  41. Attribute cmdGroup.VB_VarHelpID = -1
  42. Private WithEvents cmdGroup0        As CommandButton
  43. Attribute cmdGroup0.VB_VarHelpID = -1
  44. Private WithEvents cmdGroup1        As CommandButton
  45. Attribute cmdGroup1.VB_VarHelpID = -1
  46. Private WithEvents cmdGroup2        As CommandButton
  47. Attribute cmdGroup2.VB_VarHelpID = -1
  48. Private WithEvents cmdGroup3        As CommandButton
  49. Attribute cmdGroup3.VB_VarHelpID = -1
  50. Private WithEvents cmdGroup4        As CommandButton
  51. Attribute cmdGroup4.VB_VarHelpID = -1
  52. Private WithEvents cmdGroup5        As CommandButton
  53. Attribute cmdGroup5.VB_VarHelpID = -1
  54. Private WithEvents cmdGroup6        As CommandButton
  55. Attribute cmdGroup6.VB_VarHelpID = -1
  56. Private WithEvents cmdGroup7        As CommandButton
  57. Attribute cmdGroup7.VB_VarHelpID = -1
  58. Private WithEvents cmdGroup8        As CommandButton
  59. Attribute cmdGroup8.VB_VarHelpID = -1
  60. Private WithEvents cmdGroup9        As CommandButton
  61. Attribute cmdGroup9.VB_VarHelpID = -1
  62.  
  63. Private ctl                         As Object
  64.  
  65. 'Local variables for the properties
  66. Private intGroups                   As Integer
  67. Private intCurrentGroup             As Integer
  68. Private booEditable                 As Boolean
  69. Private booIconsStayUp              As Boolean
  70.  
  71. 'Variables
  72. Private booChangeCanceled           As Boolean
  73. Private intCounter                  As Integer
  74.  
  75. 'Objects
  76. Private WithEvents txtCaption       As TextBox
  77. Attribute txtCaption.VB_VarHelpID = -1
  78. Private objChangingCommand          As CommandButton
  79. Private colIcons                    As New clsIcons
  80.  
  81. 'Events
  82. Event Click(Group As Integer, IconIndex As Integer)
  83.  
  84. '***************************************************************************
  85. 'Properties
  86. '***************************************************************************
  87. Public Property Let Caption(intIndex, strCaption As String)
  88.     'Sets the caption for a group
  89.     If intIndex <= Groups Then
  90.         Select Case intIndex
  91.             Case 0: cmdGroup0.Caption = strCaption
  92.             Case 1: cmdGroup1.Caption = strCaption
  93.             Case 2: cmdGroup2.Caption = strCaption
  94.             Case 3: cmdGroup3.Caption = strCaption
  95.             Case 4: cmdGroup4.Caption = strCaption
  96.             Case 5: cmdGroup5.Caption = strCaption
  97.             Case 6: cmdGroup6.Caption = strCaption
  98.             Case 7: cmdGroup7.Caption = strCaption
  99.             Case 8: cmdGroup8.Caption = strCaption
  100.             Case 9: cmdGroup9.Caption = strCaption
  101.         End Select
  102.         PropertyChanged "caption"
  103.     End If
  104. End Property
  105.  
  106. Public Property Let Editable(booValue As Boolean)
  107.     'Set to true when you can change the buttonbar
  108.     booEditable = booValue
  109.     PropertyChanged "Editable"
  110. End Property
  111.  
  112. Public Property Get Editable() As Boolean
  113. Attribute Editable.VB_ProcData.VB_Invoke_Property = ";Behavior"
  114.     'Retrieves true/false if you can edit the buttonbar
  115.     Editable = booEditable
  116. End Property
  117.  
  118. Public Property Let Groups(intValue As Integer)
  119.     'Set the number of groups
  120.     If intValue > 10 Then intValue = 10
  121.     intGroups = intValue
  122.     SetGroups
  123.     PropertyChanged "Groups"
  124. End Property
  125.  
  126. Public Property Get Groups() As Integer
  127. Attribute Groups.VB_Description = "Defines the number of groups"
  128. Attribute Groups.VB_ProcData.VB_Invoke_Property = ";Appearance"
  129.     'Retrieves the number of groups
  130.     Groups = intGroups
  131. End Property
  132.  
  133. Public Property Let CurrentGroup(intValue As Integer)
  134.     'Set the number of groups
  135.     intCurrentGroup = intValue
  136. End Property
  137.  
  138. Public Property Get CurrentGroup() As Integer
  139.     'Retrieves the number of groups
  140.     CurrentGroup = intCurrentGroup
  141. End Property
  142.  
  143. Public Property Let IconsStayUp(booValue As Boolean)
  144.     booIconsStayUp = booValue
  145.     
  146.     For intCounter = 1 To LargeIcon1.Count - 1
  147.         LargeIcon1(intCounter).IconsStayUp = booValue
  148.     Next
  149. End Property
  150.  
  151. Public Property Get IconsStayUp() As Boolean
  152. Attribute IconsStayUp.VB_ProcData.VB_Invoke_Property = ";Behavior"
  153.     IconsStayUp = booIconsStayUp
  154. End Property
  155.  
  156. Public Property Get ParentHwnd() As Long
  157.     'Retrieves the Hwnd from the parent
  158.     ParentHwnd = Parent.hwnd
  159. End Property
  160.  
  161. '***************************************************************************
  162. 'Methodes
  163. '***************************************************************************
  164. Public Sub Refresh()
  165.     Dim objclsIcon As clsIcon
  166.     
  167.     For intCounter = 1 To LargeIcon1.Count - 1
  168.         Unload LargeIcon1(intCounter)
  169.     Next
  170.     
  171.     intCounter = 1
  172.     For Each objclsIcon In colIcons
  173.         If objclsIcon.ParentIndex = CurrentGroup Then
  174.             'Load control
  175.             Load LargeIcon1(intCounter)
  176.             'Position of the icon
  177.             Set LargeIcon1(intCounter).Icon = objclsIcon.Icon
  178.             LargeIcon1(intCounter).Width = UserControl.Width
  179.             Select Case objclsIcon.ParentIndex
  180.                 Case 0: LargeIcon1(intCounter).Top = cmdGroup0.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  181.                 Case 1: LargeIcon1(intCounter).Top = cmdGroup1.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  182.                 Case 2: LargeIcon1(intCounter).Top = cmdGroup2.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  183.                 Case 3: LargeIcon1(intCounter).Top = cmdGroup3.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  184.                 Case 4: LargeIcon1(intCounter).Top = cmdGroup4.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  185.                 Case 5: LargeIcon1(intCounter).Top = cmdGroup5.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  186.                 Case 6: LargeIcon1(intCounter).Top = cmdGroup6.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  187.                 Case 7: LargeIcon1(intCounter).Top = cmdGroup7.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  188.                 Case 8: LargeIcon1(intCounter).Top = cmdGroup8.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  189.                 Case 9: LargeIcon1(intCounter).Top = cmdGroup9.Top + (objclsIcon.LocalIndex * LargeIcon1(intCounter).Height - 800)
  190.             End Select
  191.             'Check whether the icon must stay on top or not
  192.             LargeIcon1(intCounter).IconsStayUp = IconsStayUp
  193.             'Set caption of icon
  194.             LargeIcon1(intCounter).Caption = objclsIcon.IconCaption
  195.             LargeIcon1(intCounter).Visible = True
  196.             'intcounter++
  197.             intCounter = intCounter + 1
  198.         End If
  199.     Next
  200.     
  201. End Sub
  202.  
  203. Public Sub AddButton(Group As Integer, Index As Integer, Caption As String, Image As Picture)
  204.     'Method that will add a button to a certain group
  205.     colIcons.Add Group, Index, Caption, Image
  206.     Refresh
  207. End Sub
  208.  
  209. Public Sub DeleteButton(Group As Integer, Index As Integer)
  210.     'Method that will delete a button from a certain group
  211.     colIcons.Remove Group, Index
  212.     Refresh
  213.  
  214. End Sub
  215.  
  216. '***************************************************************************
  217. 'Private Procedures
  218. '***************************************************************************
  219. Private Function SetGroups()
  220.     Dim intI As Integer
  221.     
  222.     'Remove all buttons first
  223.     For Each ctl In Controls
  224.         If Left(ctl.Name, 8) = "cmdGroup" Then
  225.             Controls.Remove ctl.Name
  226.         End If
  227.     Next
  228.     
  229.     'Build all buttons again...
  230.     For intI = 0 To Groups
  231.         'Make sure there are always two digits for the number when you name the button
  232.         Set cmdGroup = Controls.Add("VB.CommandButton", "cmdGroup" & CStr(intI), picMain)
  233.         With cmdGroup
  234.            .Visible = True
  235.            .Height = lngHeight
  236.            .Width = .Parent.Width - 60
  237.            .Caption = "Group " & CStr(intI)
  238.            .Top = 0 + (intI * lngHeight)
  239.            .Left = 0
  240.            'Disable the focus on the commandbutton...
  241.            'Put this line in comment until you compile ... otherwise you can't use stop
  242.            NoFocusRect cmdGroup, True
  243.         End With
  244.         Select Case intI
  245.             Case 0: Set cmdGroup0 = cmdGroup
  246.             Case 1: Set cmdGroup1 = cmdGroup
  247.             Case 2: Set cmdGroup2 = cmdGroup
  248.             Case 3: Set cmdGroup3 = cmdGroup
  249.             Case 4: Set cmdGroup4 = cmdGroup
  250.             Case 5: Set cmdGroup5 = cmdGroup
  251.             Case 6: Set cmdGroup6 = cmdGroup
  252.             Case 7: Set cmdGroup7 = cmdGroup
  253.             Case 8: Set cmdGroup8 = cmdGroup
  254.             Case 9: Set cmdGroup9 = cmdGroup
  255.         End Select
  256.     Next
  257.     CurrentGroup = 1
  258.     
  259. End Function
  260.  
  261. Private Sub ButtonClick(intIndex As Integer, Optional booRaiseEvent As Boolean = True)
  262.     For Each ctl In Controls
  263.         If Left(ctl.Name, 8) = "cmdGroup" Then
  264.             If CInt(Right(ctl.Name, 1)) <= intIndex Then
  265.                 'Move button up
  266.                 ctl.Top = 0 + (CInt(Right(ctl.Name, 1)) * lngHeight)
  267.             ElseIf CInt(Right(ctl.Name, 1)) > intIndex Then
  268.                 'Move button down
  269.                 ctl.Top = picMain.Height - ((Groups - CInt(Right(ctl.Name, 1)) + 1) * lngHeight) - 60
  270.             End If
  271.         End If
  272.     Next
  273.     CurrentGroup = intIndex
  274.     Refresh
  275.  
  276.     'Trigger event
  277.     If booRaiseEvent Then RaiseEvent Click(intCurrentGroup, intIndex)
  278. End Sub
  279.  
  280. Private Sub ChangeCaption(cmdButton As CommandButton)
  281.     If Editable Then
  282.         'Remove textbox
  283.         On Error Resume Next
  284.         Controls.Remove txtCaption
  285.         'Set the global variable
  286.         Set objChangingCommand = cmdButton
  287.         'Create a txtBox to change the caption of the cmdButton
  288.         Set txtCaption = Controls.Add("VB.TextBox", "txtCaption", picMain)
  289.         With txtCaption
  290.            .BackColor = vbBlack
  291.            .ForeColor = vbWhite
  292.            .Alignment = vbCenter
  293.            .Visible = True
  294.            .Height = 285
  295.            .Width = cmdButton.Width - 30
  296.            .Left = 15
  297.            .Top = cmdButton.Top + 15
  298.            .Text = cmdButton.Caption
  299.            .SelStart = Len(cmdButton.Caption)
  300.            .SelLength = 0
  301.            .ZOrder 0
  302.         End With
  303.         txtCaption.SetFocus
  304.     End If
  305. End Sub
  306.  
  307. '***************************************************************************
  308. 'Control events
  309. '***************************************************************************
  310.  
  311. Private Sub LargeIcon1_Click(Index As Integer)
  312.     RaiseEvent Click(CurrentGroup, Index)
  313. End Sub
  314.  
  315. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  316.     Groups = PropBag.ReadProperty("Groups", 0)
  317.     Editable = PropBag.ReadProperty("Editable", False)
  318.     IconsStayUp = PropBag.ReadProperty("IconsStayUp", True)
  319.     
  320. End Sub
  321.  
  322. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  323.     Call PropBag.WriteProperty("Groups", intGroups, 0)
  324.     Call PropBag.WriteProperty("Editable", booEditable, False)
  325.     Call PropBag.WriteProperty("IconsStayUp", booIconsStayUp, True)
  326.     
  327. End Sub
  328.  
  329. Private Sub UserControl_Resize()
  330.     With picMain
  331.         .Left = 0
  332.         .Top = 0
  333.         .Height = UserControl.Height
  334.         .Width = UserControl.Width
  335.     End With
  336. End Sub
  337.  
  338. '***************************************************************************
  339. 'Textbox Events
  340. '***************************************************************************
  341. Private Sub txtCaption_KeyDown(KeyCode As Integer, Shift As Integer)
  342.     If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
  343.         If Trim(txtCaption) = "" Then
  344.         Else
  345.             txtCaption_Validate False
  346.             'Set the variable to nothing
  347.             Set objChangingCommand = Nothing
  348.             'Remove textbox
  349.             Controls.Remove txtCaption
  350.         End If
  351.     ElseIf KeyCode = vbKeyEscape Then
  352.         'Remove textbox
  353.         booChangeCanceled = True
  354.         Controls.Remove txtCaption
  355.         Exit Sub
  356.     End If
  357.     booChangeCanceled = False
  358. End Sub
  359.  
  360. Private Sub txtCaption_LostFocus()
  361.     Controls.Remove txtCaption
  362. End Sub
  363.  
  364. Private Sub txtCaption_Validate(Cancel As Boolean)
  365.     On Error GoTo Hell
  366.     If booChangeCanceled Then
  367.     Else
  368.         objChangingCommand.Caption = Trim(txtCaption)
  369.     End If
  370.     booChangeCanceled = False
  371. Hell:
  372. End Sub
  373.  
  374. '***************************************************************************
  375. 'Button events
  376. '***************************************************************************
  377. Private Sub cmdGroup0_Click()
  378.     'Move the buttons
  379.     ButtonClick 0, False
  380. End Sub
  381. Private Sub cmdGroup1_Click()
  382.     'Move the buttons
  383.     ButtonClick 1, False
  384. End Sub
  385. Private Sub cmdGroup2_Click()
  386.     'Move the buttons
  387.     ButtonClick 2, False
  388. End Sub
  389. Private Sub cmdGroup3_Click()
  390.     'Move the buttons
  391.     ButtonClick 3, False
  392. End Sub
  393. Private Sub cmdGroup4_Click()
  394.     'Move the buttons
  395.     ButtonClick 4, False
  396. End Sub
  397. Private Sub cmdGroup5_Click()
  398.     'Move the buttons
  399.     ButtonClick 5, False
  400. End Sub
  401. Private Sub cmdGroup6_Click()
  402.     'Move the buttons
  403.     ButtonClick 6, False
  404. End Sub
  405. Private Sub cmdGroup7_Click()
  406.     'Move the buttons
  407.     ButtonClick 7, False
  408. End Sub
  409. Private Sub cmdGroup8_Click()
  410.     'Move the buttons
  411.     ButtonClick 8, False
  412. End Sub
  413. Private Sub cmdGroup9_Click()
  414.     'Move the buttons
  415.     ButtonClick 9, False
  416. End Sub
  417. Private Sub cmdGroup0_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  418.     If Button = vbRightButton Then ChangeCaption cmdGroup0
  419. End Sub
  420. Private Sub cmdGroup1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  421.     If Button = vbRightButton Then ChangeCaption cmdGroup1
  422. End Sub
  423. Private Sub cmdGroup2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  424.     If Button = vbRightButton Then ChangeCaption cmdGroup2
  425. End Sub
  426. Private Sub cmdGroup3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  427.     If Button = vbRightButton Then ChangeCaption cmdGroup3
  428. End Sub
  429. Private Sub cmdGroup4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  430.     If Button = vbRightButton Then ChangeCaption cmdGroup4
  431. End Sub
  432. Private Sub cmdGroup5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  433.     If Button = vbRightButton Then ChangeCaption cmdGroup5
  434. End Sub
  435. Private Sub cmdGroup6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  436.     If Button = vbRightButton Then ChangeCaption cmdGroup6
  437. End Sub
  438. Private Sub cmdGroup7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  439.     If Button = vbRightButton Then ChangeCaption cmdGroup7
  440. End Sub
  441. Private Sub cmdGroup8_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  442.     If Button = vbRightButton Then ChangeCaption cmdGroup8
  443. End Sub
  444. Private Sub cmdGroup9_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  445.     If Button = vbRightButton Then ChangeCaption cmdGroup9
  446. End Sub
  447.